home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
akcl
/
kcl.lha
/
c
/
fasl_io.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
6KB
|
362 lines
/*
(C) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved.
*/
/*
fasl_io.c
DG-SPECIFIC
FASL loader io routines
*/
#include "^h:fasl.h"
#include "^h:fasl_global.h"
#include <sysid.h>
#include <packets:normal_io.h>
#include <paru.h>
P_NIO_EX fas_io; /* io packet for fasl file */
P_NIO_EX fas_temp; /* io packet for temp file */
/* open fasl file */
fasl_open(namep)
char *namep; /* file name byte pointer */
{
int ac0, ac1, ac2, ier;
if (fas_io.ich != 0 ) {
/* ier = fasl_close();
if (ier != 0) return(ier); */
fasl_close();
}
fas_io.isti = $ICRF | $OFIN | $RTDY;
fas_io.imrs = -1;
fas_io.ibad = -1;
fas_io.ircl = -1;
fas_io.ifnp = namep; /* file name pointer */
fas_io.idel = -1;
ac2 = &fas_io;
return(sys($OPEN, &ac0, &ac1, &ac2));
}
/* close FASL file */
fasl_close()
{
int ac0, ac1, ac2, ier;
ac2 = &fas_io;
ier = sys($CLOSE, &ac0, &ac1, &ac2);
/* if (ier != 0) return(ier); ignore error */
fasl_clear_pack(&fas_io);
return(0);
}
/* clear io packet */
fasl_clear_pack(iopack)
P_NIO_EX *iopack;
{
(*iopack).ich = 0;
(*iopack).isti = 0;
(*iopack).isto = 0;
(*iopack).imrs = 0;
(*iopack).ibad = 0;
(*iopack).ires = 0;
(*iopack).ircl = 0;
(*iopack).irlr = 0;
(*iopack).irnw = 0;
(*iopack).irnh = 0;
(*iopack).ifnp = 0;
(*iopack).idel = 0;
(*iopack).etsp = 0;
(*iopack).etft = 0;
(*iopack).etlt = 0;
(*iopack).enet = 0;
}
/* get next fasl block */
fasl_nblock()
{
int ac0, ac1, ac2, ier;
short block_len; /* block length */
fas_io.isti = $RTDY;
fas_io.ibad = fas_buffp;
fas_io.ircl = FAS_HEADER_BLEN;
fas_io.irnh = 0;
ac2 = &fas_io;
ier = sys($READ, &ac0, &ac1, &ac2); /* get header only */
/* if (ier != 0) return(ier); */
if (ier != 0) sys_emes(ier); /* not return */
block_len = ((FAS_HDR_P)fas_buffp)->hdr_len; /* set block len */
/* if no block body , then return to caller */
if (block_len <= FAS_HEADER_LEN) return(0);
/* we must read block body */
fas_io.ibad = fas_buffp + FAS_HEADER_BLEN;
fas_io.ircl = block_len * 2 - FAS_HEADER_BLEN;
if (fas_io.ircl > FAS_BUFF_LEN - FAS_HEADER_BLEN)
fasl_invalid();
ac2 = &fas_io;
/* return(sys($READ, &ac0, &ac1, &ac2)); */
ier = sys($READ, &ac0, &ac1, &ac2);
if (ier != 0) sys_emes(ier);
}
/* reset file position */
fasl_rpos()
{
int ac0, ac1, ac2, ier;
fas_io.isti = $IPST | $RTDY;
fas_io.irnh = 0;
fas_io.ircl = 0;
ac2 = &fas_io;
/* return(sys($SPOS, &ac0, &ac1, &ac2)); */
ier = sys($SPOS, &ac0, &ac1, &ac2);
if (ier != 0) sys_emes(ier);
}
fasl_open_temp()
{
int ac0, ac1, ac2, ier;
get_pid();
copypid(fas_temp_name+1);
if (fas_temp.ich != 0) {
/* ier = fasl_close_temp();
if (ier != 0) return(ier); */
fasl_close_temp();
}
fas_temp.isti = $OFCR | $OFCE | $ICRF | $OFIO | $RTFX;
fas_temp.imrs = -1;
fas_temp.ibad = fas_temp_buff;
fas_temp.ircl = FAS_BUFF_LEN;
fas_temp.ifnp = fas_temp_name;
fas_temp.idel = -1;
ac2 = &fas_temp;
ier = sys($OPEN, &ac0, &ac1, &ac2);
if (ier != 0) sys_emes(ier);
}
fasl_close_temp()
{
int ac0, ac1, ac2, ier;
ac2 = &fas_temp;
ier = sys($CLOSE, &ac0, &ac1, &ac2);
fasl_clear_pack(&fas_temp);
if (ier != 0) sys_emes(ier);
ac0 = fas_temp_name;
sys($DELETE, &ac0, &ac1, &ac2);
}
fasl_read_temp(recno)
int recno;
{
int ac0, ac1, ac2, ier;
fas_temp.isti = $IPST | $RTFX;
fas_temp.irnh = fas_temp_curr = recno;
ac2 = &fas_temp;
ier = sys($READ, &ac0, &ac1, &ac2);
if (ier != 0) sys_emes(ier);
}
fasl_write_temp()
{
int ac0, ac1, ac2, ier;
fas_temp.isti = $IPST | $RTFX;
fas_temp.irnh = fas_temp_curr; /* cuurent record in memory */
ac2 = &fas_temp;
ier = sys($WRITE, &ac0, &ac1, &ac2);
if (ier != 0) sys_emes(ier);
}
fasl_read_addr_rec(recno)
int recno;
{
int ac0, ac1, ac2, ier;
fas_temp.isti = $IPST | $RTFX;
fas_temp.irnh = fas_addr_rec_first + recno;
fas_temp.ibad = fas_addr_buff;
ac2 = &fas_temp;
ier = sys($READ, &ac0, &ac1, &ac2);
fas_temp.ibad = fas_temp_buff;
if (ier != 0)
sys_emes(ier);
fas_addr_rec_curr = recno;
}
fasl_write_addr_rec(recno)
int recno;
{
int ac0, ac1, ac2, ier;
fas_temp.isti = $IPST | $RTFX;
fas_temp.irnh = fas_addr_rec_first + recno;
fas_temp.ibad = fas_addr_buff;
ac2 = &fas_temp;
ier = sys($WRITE, &ac0, &ac1, &ac2);
fas_temp.ibad = fas_temp_buff;
if (ier != 0)
sys_emes(ier);
}
/* Old one. New one below.
fasl_openst()
{
int ac0,ac1,ac2,ier;
P_NIO_EX fas_stio;
char st_name[256];
get_stname(st_name);
fasl_clear_pack(&fas_stio);
fas_stio.ich = 0;
fas_stio.isti = $OFIN | $RTDY;
fas_stio.imrs = -1;
fas_stio.ibad = -1;
fas_stio.ircl = -1;
fas_stio.ifnp = st_name;
fas_stio.idel = -1;
fas_stio.etsp = 0;
fas_stio.etft = 0;
fas_stio.etlt = 0;
ac2 = &fas_stio;
ier = sys($OPEN,&ac0,&ac1,&ac2);
if (ier != 0) sys_emes(ier);
fas_stchan = fas_stio.ich;
}
*/
/* New fasl_openst for AOS/VS REV 5.03 */
fasl_openst()
{
int ac0, ac1, ac2, ier;
char st_name[256];
get_stname(st_name);
ac0 = st_name;
ac1 = -1;
ac2 = 0;
if(ier = sys($SOPEN, &ac0, &ac1, &ac2))
sys_emes(ier);
fas_stchan = ac1;
}
/* get symbol value */
fasl_st(symp, symv)
char *symp; /* symbol byte pointer */
int *symv; /* symbol value returned */
{
int ac0,ac1,ac2,ier;
int symlen;
for (symlen = 0; symp[symlen] != '\0'; symlen++)
;
ac1 = (symlen << 8) | fas_stchan;
ac2 = symp;
ier = sys($GTSVL,&ac0,&ac1,&ac2);
if (ier == 0) {
*symv = ac0;
return(0);
} else
return(ier);
}
get_stname(st_name)
char *st_name;
{
int i, j;
char *cp;
get_prname(st_name);
for (i = 0; st_name[i] != '\0'; i++)
;
if ((i - 3) > 0) {
cp = st_name + i - 3;
if (strcmp(cp, ".PR") == 0) i = i - 3;
}
st_name[i++] = '.';
st_name[i++] = 'S';
st_name[i++] = 'T';
st_name[i] = '\0';
}
get_prname(pr_name)
char *pr_name;
{
int ac0, ac1, ac2, ier;
ac0 = -1;
ac2 = pr_name;
ier = sys($GPRNM, &ac0, &ac1, &ac2);
if (ier != 0) sys_emes(ier);
}
init_fasl_io()
{
fasl_clear_pack(&fas_io);
fasl_clear_pack(&fas_temp);
}
/* skip first text */
fasl_skip(count)
int count;
{
int ac0, ac1, ac2, ier;
int rec_count;
fas_io.isti = $IPST;
fas_io.irnh = count;
ac2 = &fas_io;
if (ier = sys($SPOS, &ac0, &ac1, &ac2))
sys_emes(ier);
/*
while (count > 0) {
fas_io.isti = $RTDY;
fas_io.ibad = fas_buffp;
if (count > FAS_BUFF_LEN) {
fas_io.ircl = FAS_BUFF_LEN;
count -= FAS_BUFF_LEN;
} else {
fas_io.ircl = count;
count = 0;
}
ac2 = &fas_io;
ier = sys($READ, &ac0, &ac1, &ac2);
if (ier) sys_emes(ier);
}
*/
}